home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Ultimate Window Set -…Games & Quality Programs
/
The Ultimate Window Set - 250 Games & Quality Programs.iso
/
win
/
pro125
/
calcul.cdl
next >
Wrap
Text File
|
1993-09-10
|
5KB
|
247 lines
//⌐ David Jean, 1993
game calculation is 21 by 18;
// A1 A2 A3 A4
// B1 B2 B3 B4
// D1
{--------------------------------------------------------------------------}
{****c2 est un de plus que c1}
predicate FollowWrap1?(c1, c2 : Card) is
return ((c1 + 1) mod 13) = (c2 mod 13);
{****c2 est deux de plus que c1}
predicate FollowWrap2?(c1, c2 : Card) is
return ((c1 + 2) mod 13) = (c2 mod 13);
{****c2 est trois de plus que c1}
predicate FollowWrap3?(c1, c2 : Card) is
return ((c1 + 3) mod 13) = (c2 mod 13);
{****c2 est quatre de plus que c1}
predicate FollowWrap4?(c1, c2 : Card) is
return ((c1 + 4) mod 13) = (c2 mod 13);
procedure MoveFirstFrom(c1 : card; src : stack) is
var i : integer;
begin
i:=1;
while 1<src! do
if (src[i] mod 13)=c1 then
begin
Move src[i] to [1];
break;
end
else i:=i+1;
end;
{--------------------------------------------------------------------------}
procedure About is
begin
Clear 'About Calcul';
write('Rules from : RΘglements officiels des jeux de cartes, Intl. playing card company limited, 1977.\n');
write('Program : ⌐ David Jean, 1993.\n');
end;
procedure ShowSuite is
begin
Write('Ace 2 3 4\n');
Write('2 4 6 8\n');
Write('3 6 9 Queen\n');
Write('4 8 Queen 3\n');
Write('5 10 2 7\n');
Write('6 Queen 5 Jack\n');
Write('7 Ace 8 2\n');
Write('8 3 Jack 6\n');
Write('9 5 Ace 10\n');
Write('10 7 4 Ace\n');
Write('Jack 9 7 5\n');
Write('Queen Jack 10 9\n');
Write('King King King King\n');
Wait 'About...' About;
end;
stack A1;
stack A2;
stack A3;
stack A4;
stack B1;
stack B2;
stack B3;
stack B4;
var src : stack;
stack D1 is
X := 2;
Y := 9;
Direction := over;
w := 3;
h := 4;
//****************************
Start is
begin
Add Ace+Spade .. king+Diamond;
Shuffle;
[0]:=CrossCard;
end;
//****************************
SelectFrom(Spos : Index) is
begin
if !>0 then
begin
Pull 1 to Cursor;
src:=D1;
end;
end;
//****************************
Help is
begin
Clear 'The Stock';
Write('You build The Tableau or the Foundation by dragging cards from here, one by one.\n');
Wait 'About...' About;
end;
end D1;
{--------------------------------------------------------------------------}
stack A1 is
X := 6;
Y := 2;
Direction := over;
w := 3;
h := 4;
//****************************
Start is
MoveFirstFrom(Ace,D1);
//****************************
SelectTo(Spos : Index) is
begin
if FollowWrap1?([!],Cursor[1]) then
Pull 1 From Cursor;
end;
//****************************
Help is
begin
Clear 'Foundations';
Write('Arithmetic sequences are build here.\n');
Write('The Suite is not important.\n\n');
Write('The goal is to bring every sequence to the king.\n\n');
Wait 'Sequences...' ShowSuite;
Wait 'About...' About;
end;
end A1;
stack A2 is
X := 10;
Y := 2;
Direction := over;
w := 3;
h := 4;
//****************************
Start is
MoveFirstFrom(Deuce,D1);
//****************************
SelectTo(Spos : Index) is
begin
if FollowWrap2?([!],Cursor[1]) then
Pull 1 From Cursor;
end;
//****************************
Help from A1;
end A2;
stack A3 is
X := 14;
Y := 2;
Direction := over;
w := 3;
h := 4;
//****************************
Start is
MoveFirstFrom(Three,D1);
//****************************
SelectTo(Spos : Index) is
begin
if FollowWrap3?([!],Cursor[1]) then
Pull 1 From Cursor;
end;
//****************************
Help from A1;
end A3;
stack A4 is
X := 18;
Y := 2;
Direction := over;
w := 3;
h := 4;
//****************************
Start is
MoveFirstFrom(Four,D1);
//****************************
SelectTo(Spos : Index) is
begin
if FollowWrap4?([!],Cursor[1]) then
Pull 1 From Cursor;
end;
//****************************
Help from A1;
end A4;
{--------------------------------------------------------------------------}
stack B1 is
X := 6;
Y := 7;
Direction := down;
w := 3;
h := 11;
//****************************
SelectFrom(Spos : Index) is
begin
if !>0 then
begin
Pull 1 to Cursor;
src:=self;
end;
end;
//****************************
SelectTo(Spos : Index) is
begin
if src=D1 then Pull 1 from Cursor;
end;
//****************************
Help is
begin
Clear 'The Tableau';
Write('You can bring cards from The Stock here.\n\n');
Write('Only the topmost card can be moved, and only to the Foundation.');
Wait 'About...' About;
end;
end B1;
stack B2 from B1 is
X := 10;
Y := 7;
end B2;
stack B3 from B1 is
X := 14;
Y := 7;
end B3;
stack B4 from B1 is
X := 18;
Y := 7;
end B4;
{--------------------------------------------------------------------------}
predicate Win? is return (A1!=13) and (A2!=13) and (A3!=13) and (A4!=13);
order D1, A1, A2, A3, A4, B1, B2, B3, B4.